home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / tex / refs51.zip / REFS51.PAS < prev   
Pascal/Delphi Source File  |  1989-11-06  |  18KB  |  639 lines
  1. {$R-}    {Range checking off}
  2. {$B-}    {Boolean short circuiting off}
  3. {$S+}    {Stack checking on}
  4. {$I+}    {I/O checking on}
  5. {$N-}    {No numeric coprocessor}
  6.  
  7. program refs;
  8.  
  9.     (*REFS-- find and list references in manuscripts
  10.  
  11.   COPYRIGHT 1985 by Ross A. Alford
  12.   All commercial rights reserved.  This software is released for
  13.   nonprofit distribution only.    Any commercial distribution should be
  14.   undertaken only with the express consent of the copyright holder:
  15.  
  16.             Ross A. Alford
  17.             Department of Zoology
  18.             Duke University
  19.             Durham, NC 27706
  20.             ...[decvax, ihnp4, akgua]!mcnc!ecsvax!alford
  21.  
  22.   REFS finds references in scientific manuscripts.  It will list references
  23.   found and the number of times they are occur to a file, a printer, or
  24.   the system console.  It  should work with references of the forms:
  25.  
  26.    Smith, 1980                   |Smith (1980)
  27.      Smith, 1980a                  |Smith (1980a)
  28.      Smith, 1980a, b               |Smith (1980a, b)
  29.      Smith, 1980a, 1980b           |Smith (1980a, 1980b)
  30.      Smith and Smith, 1980         |Smith and Smith (1980)
  31.      Smith et al., 1980            |Smith et al. (1980)
  32.      Smith's 1980                  |Smith's (1980)
  33.      Smith, Smith, and Smith, 1980 |Smith, Smith, and Smith (1980)
  34.      Smith-Smythe and Smith 1980
  35.  
  36.      Smith {\it et al.} (1980)            ( Added by JM-M, see below )
  37.      \fnote{Smith (1980)}           (           ditto          )
  38.  
  39.   and with most any similar style.  It also allows the last digit of the year
  40.   to be replaced by a letter, as Smith, 198x, for cases where the exact date
  41.   is uncertain.  It may not work entirely properly on references in tabular
  42.   formats, specifically if a reference of the form Smith 1980a,b is split
  43.   between lines so that the 'b' is widely separated from the 'a'.
  44.  
  45.   Month, year dates, as July, 1980, also are treated as references.  You never
  46.   know when some person might have the same name as a month.
  47.  
  48.   Operating the program is simple, and is documented in the msgexit function.
  49.   Just run the program with no parameters for a description.  I apologize for
  50.   the paucity of comments, but after all this is self-documenting Pascal :-)
  51.  
  52.   Please let me know of any bugs found, bug fixes made, or improvements
  53.   made.
  54.  
  55.     Ross Alford*)
  56.  
  57. (* REVISED
  58.  
  59.   Version:       1.5j
  60.   Revisions by:  Jeff_MacKie-Mason@um.cc.umich.edu
  61.                  Dept. of Economics
  62.                  Univ. of Michigan
  63.                  Ann Arbor, MI 48109
  64.  
  65.   Revision date: 18 November 1987
  66.                                 6 November 1989
  67.  
  68.   Revision abstract:
  69.      1) Upgraded for compilation with Turbo Pascal v. 4.0.
  70.           Actually, I used the Turbo3 standard unit, so version 3.0
  71.           definitions are mostly in effect, but compiling with v. 4.0
  72.           leads to a smaller executable.
  73.  
  74.           Had to change DOS device names, and add a result parameter
  75.           to blockread to handle incomplete reads.
  76.  
  77.      2) Rewrote GetArg function to use ParamStr (especially since
  78.                     it is illegal to use CSeg in an absolute declaration)
  79.  
  80.          3) Changed MemAvail to longint, converted returned bytes to paragraphs,
  81.                 deleted reference to Turbo3 unit, recompiled with Turbo5. (11/6/89)
  82.  
  83.          4) Modified logic to recognize refs that begin \fnote's,
  84.                 and refs of the form Baker {\it et al.} (1980) in TeX. (11/6/89)
  85.  
  86.          5) Modified logic to recognize \footnote and refs of form
  87.                 Baker {\em et al.} (1980) for LaTex.  (11/7/89)
  88. *)
  89.  
  90. Uses
  91.     Crt;
  92.  
  93. const charsect = 128;
  94.       namelen = 60;
  95.             version = '1.3';
  96.             jversion = '5.1j';
  97.  
  98. type fnamestr = string[14];
  99.      msgstr = string[80];
  100.      tabletyp = array[0..127] of boolean;
  101.      buftype = array[1..CHARSECT] of byte;
  102.      nametyp = string[NAMELEN];
  103.      datetyp = string[5];
  104.      refptr = ^reference;
  105.      reference = record
  106.            next : refptr;
  107.            name : string[NAMELEN];
  108.            number : integer
  109.          end;
  110.      sectptr = ^sectrec;
  111.      sectrec = record
  112.         next : sectptr;
  113.         previous : sectptr;
  114.         data : buftype
  115.           end;
  116.  
  117. var inf : file;
  118.     i,j,ptrsave,sinceref : integer;
  119.     c : byte;
  120.     oldyear,year : datetyp;
  121.     xtra,name,tempname,oldname : nametyp;
  122.     closeparen,notfound : boolean;
  123.     outfname,infile : fnamestr;
  124.     reflist : refptr;
  125.     result : word;                             { new in v.1.3j}
  126.  
  127. {intentional global variables- to speed things up}
  128.  
  129.     outf : text;
  130.     lowcase,isupcase,otherbad,letter,number : tabletyp;
  131.     cursectnum,numinfile : integer;
  132.     infopen,outfopen,hitnumber,comma,done : boolean;
  133.     sector,savesect : sectptr;        {current sector in use}
  134.     ptr,saveptr : integer;        {location within sector}
  135.  
  136.  
  137. {---------exit gracefully with info---------------------------------------}
  138.  
  139. procedure msgexit(msg : msgstr);
  140.  
  141. begin
  142.   if infopen then close(inf);
  143.   if outfopen then close(outf);
  144.   writeln;
  145.   if msg <> '' then
  146.     begin
  147.       writeln(chr(7),msg);
  148.       writeln
  149.     end;
  150.   writeln('REFS finds references in the name, date form in manuscripts.');
  151.   writeln;
  152.   writeln('To run REFS enter a command line like:');
  153.   writeln;
  154.   writeln('A>refs infile {outfile}');
  155.   writeln;
  156.   writeln('Where infile is a DOS filename of the form drive:filename.ext');
  157.   writeln;
  158.   writeln('and outfile can be either a disk file, given in the same format ');
  159.   writeln('as infile, or can be given as CON to send output to the CRT screen');
  160.   writeln('or LPT1 to send output to the DOS list device.');
  161.   writeln;
  162.   writeln('If outfile is not specified, a file of the same base name as infile');
  163.   writeln('but with the extension .REF, will be created on the same drive that');
  164.   writeln('infile is read from.');
  165.   writeln;
  166.   halt
  167. end;
  168.  
  169.  
  170. {---------------------read a sector into a sector buffer-------------------}
  171.  
  172. procedure readsector(var sector : sectptr);
  173.  
  174. begin
  175.   if cursectnum < numinfile then
  176.     begin
  177.       blockread(inf,sector^.data,1);
  178.       cursectnum := succ(cursectnum)
  179.     end
  180.     else done := TRUE
  181. end;
  182.  
  183.  
  184. {------------------------get a new sector buffer node-------------------}
  185.  
  186. procedure getsectnode(var sector : sectptr);
  187.  
  188. var n : longint;
  189.  
  190. begin
  191.     n := memavail div 16;
  192.   if ((n and $7fff) < 512) then msgexit('Out of memory during sector read');
  193.   new(sector);
  194.   sector^.next := NIL;
  195.   sector^.previous := NIL
  196. end;
  197.  
  198.  
  199. {----------------return the character currently pointed to-------------}
  200.  
  201. function curbyte : byte;           {uses globals sector and ptr}
  202.  
  203. begin
  204.   curbyte := sector^.data[ptr] and $7f
  205. end;
  206.  
  207.  
  208. {---------get next character, read a new sector if needed--------------}
  209.  
  210. function nextbyte : byte;           {uses globals sector and ptr}
  211.  
  212. var tempsec : sectptr;
  213.     t : byte;
  214.  
  215. begin
  216.   ptr := succ(ptr);
  217.   if ptr > 128 then
  218.     if sector^.next = NIL then
  219.       begin
  220.     tempsec := sector^.previous;
  221.     if tempsec = NIL then getsectnode(tempsec);
  222.     readsector(tempsec);
  223.     if not done then
  224.       begin
  225.         tempsec^.previous := sector;
  226.         sector^.previous := NIL;
  227.         sector^.next := tempsec;
  228.         tempsec^.next := NIL;
  229.         sector := tempsec;
  230.         ptr := 1
  231.       end
  232.       end
  233.       else begin
  234.     tempsec := sector^.next;
  235.     tempsec^.next := NIL;
  236.     tempsec^.previous := sector;
  237.     sector^.previous := NIL;
  238.     sector := tempsec;
  239.     ptr := 1;
  240.       end;
  241.   t := sector^.data[ptr];
  242.   if t = 26 then done := TRUE;
  243.   nextbyte := t and $7f
  244. end;
  245.  
  246.  
  247. {--------------------return previous character--------------------}
  248.  
  249. function prevbyte : byte;           {uses globals sector and ptr}
  250.  
  251. var tempsec : sectptr;
  252.     ch : byte;
  253.  
  254. begin
  255.   ptr := pred(ptr);
  256.   if ptr < 1 then
  257.     begin
  258.       if sector^.previous <> NIL then
  259.     begin
  260.       tempsec := sector^.previous;
  261.       tempsec^.next := sector;
  262.       tempsec^.previous := NIL;
  263.       sector^.next := NIL;
  264.       sector := tempsec;
  265.       ptr := 128
  266.     end
  267.     end;
  268.   if (ptr < 1) then
  269.     prevbyte := 0
  270.     else prevbyte := sector^.data[ptr] and $7f
  271. end;
  272.  
  273.  
  274. {return previous alphabetic word.  Set the global 'comma'=TRUE if a comma
  275.   follows it.  Set the global 'hitnumber' TRUE if a digit is encountered.
  276.   Return no word if any of the characters for which corres